The X-Philes (2nd Revision)/The X-Philes Number 1 (1995).iso/xphiles/hp48hor1/roborun.src

Text File | 1990-10-18 | 10KB | 392 lines

%%HP: T(3)A(D)F(.);
@ by David Liu; this is shareware.
@ This is part 1 of a two-part source-code listing.
@   Part 2 is ROBORUN2.SRC.  -jkh-
DIR
  STRT
    \<< RCLF 'USRF' STO 0 RDZ { # 4000103F0h # 0h } STOF # 83h # 40h PDIM
      DO PICT { # 0h # 0h } STSCR REPL { # 0h # 0h } PVIEW 0
        DO DROP 0 WAIT
        UNTIL { 11.1 16.1 } SWAP POS DUP
        END
        IF 1 ==
        THEN PLAY 1
        ELSE INSTR 0
        END
      UNTIL
      END
    \>>
  INSTR
    \<< PICT { # 0h # 0h } INSC1 REPL INSS1 SNG 0 WAIT DROP
        PICT { # 0h # 0h } INSC2 REPL INSS2 SNG 0 WAIT DROP
        PICT { # 0h # 0h } INSC4 REPL INSS3 SNG 0 WAIT DROP
        PICT { # 0h # 0h } INSC5 REPL INSS4 SNG 0 WAIT DROP
        PICT { # 0h # 0h } INSC3 REPL INSS5 SNG 0 WAIT DROP
    \>>
  INSS1
"2H1H8M6O1P1R8P8H2H8M2O2P2H1P1M1T9R"
  INSS2
"2H1H8M2O2P2M4T2P9Y4M1P1O1M6T1P1M4H4H1H8M"
  INSS3
"1H1H1H5M5T1R1Q1O5Y5T1R1Q1O5Y5T1R1Q1R7O"
  INSS4
"2H2H8J2J2R2Q2O2M1M1O1Q4O2J6L2H2H8J2J2R2Q2O2M6T6O"
  INSS5
"2H2H8J2J2R2Q2O2M1M1O1Q4O2J6L2T2T2Y2W4U1T2R2P4O2M6T1T1T8T"
  BONS
"1H1I1J1L3Q1L3Q1L6Q1Q1S1T1U1Q1S3U1P3S6Q"
  EXP2
    \<< 'SCOR' LEV 3 / 500 * STO+ UPSC
    \>>
  FLS
    \<< 1 3
      START 100 .3
BEEP
      NEXT
    \>>
  BFAIL
    \<< REPL FLS 'SCOR' LEV 3 / 500 * STO- UPSC
    \>>
  EXPP
    \<< EXPLG GXOR EXPS 'SCOR' LEV 3 / 500 * STO+ UPSC
    \>>
  EXPS
    \<< 1 6
      START 2000 .02 BEEP
      NEXT 1 10
      START RAND 90 * 80 + .03 BEEP
      NEXT
    \>>
  BCHK
    \<< 2 CF 3 CF 4 CF
      WHILE KEY
      REPEAT { 62 63 64 } SWAP POS DUP
        IF
        THEN 1 + SF
        ELSE DROP
        END
      END
      IF 2 FS?
      THEN
        IF 7 FS?
        THEN { # 17h # 21h } { # 38h # 3Ah } LINE PICT { # 8h # 12h } EXPP
        ELSE PICT { # Ah # 2Bh } DHG BFAIL
        END
      ELSE
        IF 7 FS?
        THEN PICT { # Ah # 2Bh } TMG BFAIL
        ELSE EXP2
        END
      END
      IF 3 FS?
      THEN
        IF 6 FS?
        THEN { # 41h # 21h } { # 41h # 37h } LINE PICT { # 32h # 12h } EXPP
        ELSE PICT { # 34h # 2Bh } DHG BFAIL
        END
      ELSE
        IF 6 FS?
        THEN PICT { # 34h # 2Bh } TMG BFAIL
        ELSE EXP2
        END
      END
      IF 4 FS?
      THEN
        IF 5 FS?
        THEN { # 6Bh # 21h } { # 4Ah # 3Ah } LINE PICT { # 5Ch # 12h } EXPP
        ELSE PICT { # 5Eh # 2Bh } DHG BFAIL
        END
      ELSE
        IF 5 FS?
        THEN PICT { # 5Eh # 2Bh } TMG BFAIL
        ELSE EXP2
        END
      END
    \>>
  BONUS
    \<< CLSCR PICT { # 1Ch # 18h } BNSSC REPL BONS SNG 1 10
      FOR X CLSCR PICT { # 37h # 38h } BGUN REPL 1 3
        FOR Z PICT BL RAND 8 * 1 + FLOOR 5 MIN DUP
          IF 5 ==
          THEN Z 4 + SF
          ELSE Z 4 + CF
          END GET
        NEXT 0 WAIT DROP 440 .3 BEEP
          { # 8h # 12h } SWAP REPL
          { # 32h # 12h } SWAP REPL
          { # 5Ch # 12h } SWAP REPL X INV 2 * .25 + WAIT 880 .3 BEEP BCHK 0
        DO KEY
        UNTIL DROP NOT
        END
      NEXT
    \>>
  PLAY
    \<< 1 CF 0 'DEAD' STO 0 'LEV' STO 0 'SCOR' STO
      PICT { # 0h # 0h } MNSC REPL UPSC
      DO 'LEV' 1 STO+ UPLV INIP PLRB PLMN
        DO MAIN
        UNTIL DEAD DONE OR
        END
        IF LEV 3 MOD NOT DONE AND
        THEN BONUS
        END
      UNTIL DEAD
      END ENDG
    \>>
  INIP
    \<< MEM DROP 0 'DONE' STO CLSCR
        PICT { # 18h # Eh } INPBX REPL
        PICT { # 50h # 20h } LEV 3 \->GROB REPL
        0 'NROB' STO { } 'PILL' STO LEV .007 * .014 + 'PROB' STO
      DO 0 125
        FOR X 9 59
          FOR Y
            IF RAND PROB <
            THEN X R\->B Y R\->B 2 \->LIST 'NROB' 1 STO+
            END 5
          STEP 5
        STEP NROB
      UNTIL 1 >
      END NROB \->LIST 'ROBL' STO 0
      DO KEY SWAP DROP
      UNTIL NOT
      END CLSCR
    \>>
  NROB 6
  PROB .021
  LEV 1
  SCOR 100
  ROBL { { # 19h # 27h } { # 23h # 22h } { # 28h # 27h } { # 32h # 22h }
    { # 50h # 22h } { # 5Fh # 1Dh } }
  MANL { # 28h # 22h }
  PLRB
    \<< ROBL LIST\-> 1 SWAP
      START PICT SWAP ROBG REPL
      NEXT
    \>>
  PLMN
    \<< 0
      DO DROP RAND 26 * 1 + FLOOR 5 * 5 - R\->B RAND 11 * 1 + FLOOR 5 * 4 +
        R\->B 2 \->LIST DUP RC NOT
      UNTIL
      END DUP 'MANL' STO PICT SWAP MANG REPL 2 WAIT GO SNG
    \>>
  MAIN
    \<<
      IF KEY
      THEN { 82 83 84 72 73 74 62 63 64 } SWAP POS
        IF DUP
        THEN
          IF DUP 5 ==
          THEN DROP TELE
          ELSE \->STR "M" SWAP + STR\-> EVAL MOVM
          END
        END
      END MOVR
    \>>
  CLSCR
    \<< PICT { # 1h # Ah } # 83h # 37h BLANK REPL
    \>>
  UPLV
    \<< PICT { # 78h # 0h } LEV \->STR 2 \->GROB REPL
    \>>
  UPSC
    \<< PICT { # 24h # 0h } SCCS REPL PICT { # 24h # 0h } SCOR \->STR 2
      \->GROB REPL
    \>>
  PC
    \<< LIST\-> DROP 4 + SWAP 2 + SWAP 2 \->LIST PIX?
    \>>
  RC
    \<< LIST\-> DROP 1 + SWAP 2 + SWAP 2 \->LIST PIX?
    \>>
  DEAD 1
  DONE 0
  DIE2 "5H2M9Q"
  DIE1 "5H2H9M"
  KEYL { 11.1 12.1 13.1 14.1 15.1 16.1 21.1 22.1 23.1 24.1 25.1 26.1 31.1 32.1
    33.1 34.1 35.1 36.1 41.1 42.1 43.1 44.1 45.1 46.1 52.1 53.1 51.1 94.1 }
  ALPHL { "A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M" "N" "O" "P" "Q"
    "R" "S" "T" "U" "V" "W" "X" "Y" "Z" "\161" " " }
  GETN
    \<< 0
      DO KEY
      UNTIL SWAP DROP NOT
      END PICT { # 0h # 9h } NMSCR REPL "" (-2.7,-1.1) \-> B
      \<<
        WHILE ALPHL KEYL 0 WAIT POS GET DUP "\161" == NOT
        REPEAT \-> A
          \<< A + PICT B A 2 \->GROB REPL (.6,0) 'B' STO+
          \>>
        END DROP
      \>>
    \>>
  HSL { 8 6 4 2 "" }
  ADJHS
    \<< \-> A
      \<< HS 1 A 1 - SUB SCOR HS  A 3 SUB + + 0 CHR + 'HS'  STO
         HSL 1 A 1 - SUB LEV  HSL A 3 SUB + + 0 CHR + 'HSL' STO
         HSN 1 A 1 - SUB GETN HSN A 3 SUB + + 0 CHR + 'HSN' STO
      \>>
    \>>
  LOCS
"2I1J2L6Q2G1I6J2L1N2P6V2N1P4Q4S4U2I1J2L6Q2S1U6V2L1L4U2S1L4U2S1L4V2U3S6Q"
  HSN { "DAVID LIU" "DAVID LIU" "DAVID LIU" "DAVID LIU" "" }
  HS { 103500 42600 22600 3100 "" }
  ENDG
    \<< PICT { # 0h # 9h } ENDSC REPL
        DIE1 SNG .44 WAIT
        DIE2 SNG 1 WAIT
      IF SCOR HS 4 GET >
      THEN 1 SF
        CASE SCOR HS 1 GET >
          THEN 1 ADJHS
          END SCOR HS 2 GET >
          THEN 2 ADJHS
          END SCOR HS 3 GET >
          THEN 3 ADJHS
          END 1
          THEN 4 ADJHS
          END
        END
      END PICT { # 0h # 0h } LOCSC REPL 1 4
      FOR C HS C GET \->STR " LEV " + HSL C GET \->STR + " " + HSN C GET + 2
        \->GROB PICT SWAP # 0h # 5h C 12 * R\->B + 2 \->LIST SWAP REPL
      NEXT
      IF 1 FS?
      THEN LOCS SNG
      END USRF STOF 0
      DO KEY SWAP DROP
      UNTIL NOT
      END 0 WAIT DROP
    \>>
  ZOOM
    \<< 1 10
      FOR X X 90 * .05 BEEP
      NEXT
    \>>
  CHRG
"1H1L1O3T1O4T"
  SNG
    \<< MEM DROP \-> A
      \<< 1 A SIZE 2 /
        FOR X A X 2 * 1 - DUP SUB A X 2 * DUP SUB NUM 65 - 12 / 2 SWAP ^ 110 *
          SWAP STR\-> 11 / BEEP
        NEXT
      \>>
    \>>
  GO "5H5H5H8T"
  PILL { }
  RFL
    \<< 'SCOR' 100 LEV * STO+ UPSC 6 1
      FOR X X 10 * 30 + .05 BEEP -1
      STEP \-> Z
      \<< ROBL 1 Z 1 - SUB ROBL Z 1 + NROB SUB + 'ROBL' STO 'NROB' 1 STO-
      \>>
    \>>
  TELE
    \<< PICT MANL TELG REPL MANL RAND 26 * 1 + FLOOR 5 * 5 - R\->B RAND 11 * 1
      + FLOOR 5 * 4 + R\->B 2 \->LIST 'MANL' STO CLSQ ZOOM
      IF MANL RC MANL PC OR
      THEN PICT MANL PILG REPL 1 'DEAD' STO
      ELSE PICT MANL MANG REPL 'SCOR' 100 STO- UPSC
      END
    \>>
  CKRB
    \<< ROBL LIST\-> 1 CLSCR PICT MANL MANG REPL PILL LIST\-> DUP
      IF
      THEN 1 SWAP
        START PICT SWAP PILG REPL
        NEXT
      ELSE DROP
      END
      FOR X \-> B
        \<<
          IF B RC
          THEN X RFL ROBL B POS RFL PICT B PILG REPL B 1 \->LIST 'PILL' STO+
          ELSE
            IF B PC
            THEN
              IF B MANL ==
              THEN 1 'DEAD' STO
              END X RFL PICT B PILG REPL
            ELSE PICT B ROBG REPL
            END
          END
        \>> -1
      STEP
      IF NROB NOT
      THEN 1 'DONE' STO CLSCR PICT { # 0h # 9h } LCSC REPL
      PICT { # Eh # 1Fh } LEV 2 \->GROB REPL
      PICT { # 61h # 25h } LEV 1000 * 2 \->GROB REPL
      'SCOR' LEV 1000 * STO+ UPSC CHRG SNG 2 WAIT
      END
    \>>
  MOVR
    \<< ROBL 1 NROB
      FOR X DUP X GET LIST\-> DROP MANL LIST\-> DROP \-> A B C D
        \<<
          IF A C >
          THEN A # 5h -
          ELSE
            IF A C <
            THEN A # 5h +
            ELSE A
            END
          END
          IF B D >
          THEN B # 5h -
          ELSE
            IF B D <
            THEN B # 5h +
            ELSE B
            END
          END
        \>> 2 \->LIST X SWAP PUT
      NEXT 'ROBL' STO CKRB
    \>>
  M9
    \<< MANL LIST\-> DROP B\->R 5 - 9 MAX R\->B SWAP B\->R 5 + 125 MIN R\->B
      SWAP
    \>>
  M8
    \<< MANL LIST\-> DROP B\->R 5 - 9 MAX R\->B
    \>>
  M7
    \<< MANL LIST\-> DROP B\->R 5 - 9 MAX R\->B SWAP B\->R 5 - 0 MAX R\->B
      SWAP
    \>>
  M6
    \<< MANL LIST\-> DROP SWAP B\->R 5 + 125 MIN R\->B SWAP
    \>>
  M4
    \<< MANL LIST\-> DROP SWAP B\->R 5 - 0 MAX R\->B SWAP
    \>>
  M3
    \<< MANL LIST\-> DROP B\->R 5 + 59 MIN R\->B SWAP B\->R 5 + 125 MIN R\->B
      SWAP
    \>>
  M2
    \<< MANL LIST\-> DROP B\->R 5 + 59 MIN R\->B
    \>>
  M1
    \<< MANL LIST\-> DROP B\->R 5 + 59 MIN R\->B SWAP B\->R 5 - 0 MAX R\->B
      SWAP
    \>>
  CLSQ
    \<< PICT SWAP CLG REPL
    \>>
  MOVM
    \<< 2 \->LIST MANL CLSQ 'MANL' STO
      IF MANL RC MANL PC OR
      THEN PICT MANL PILG REPL 1 'DEAD' STO
      ELSE PICT MANL MANG REPL
      END
    \>>
  USRF { # 4000103F0h # 0h }
  MC
    \<< LIST\-> DROP 3 + SWAP 2 + SWAP 2 \->LIST PIX? NOT
    \>>
  PPAR { (-6.5,-3.1) (6.5,3.2) X 0 (0,0) FUNCTION Y }
END